home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / jinstall next >
Encoding:
Tcl/Tk script  |  1995-03-14  |  9.2 KB  |  359 lines
  1. #!/usr/local/bin/wish -f
  2. # procedures for an installation tool
  3.  
  4. global jinstall
  5.  
  6. ######################################################################
  7. # the following sets the header for each script.  note that %s marks the
  8. # place where $jinstall(normallib) will be inserted.
  9. set jinstall(preamble) {## begin boiler_header
  10.  
  11. global VERSION
  12. set VERSION {3.6/3.0}
  13.  
  14. if {[info exists env(JSTOOLS_LIB)]} {
  15.   set jstools_library $env(JSTOOLS_LIB)
  16. } else {
  17.   set jstools_library {%s}
  18. }
  19.  
  20. # add the jstools library to the library search path:
  21.  
  22. set auto_path [concat [list $jstools_library] $auto_path]
  23.  
  24. # check for ~/.tk and prepend it to the auto_path if it exists.
  25. # that way the user can override and customise the jstools libraries.
  26.  
  27. if {[file isdirectory ~/.tk]} then {
  28.   set auto_path [concat [list [glob ~/.tk]] $auto_path]
  29. }
  30.  
  31. ## end boiler_header
  32. }
  33. ######################################################################
  34.  
  35. proc jinstall:show_help { help } {
  36.   set ext 0
  37.   set pref .jinstall_help
  38.   while {[catch {toplevel $pref$ext}]} {
  39.     incr ext
  40.   }
  41.   set w $pref$ext
  42.   
  43.   set text {}
  44.   
  45.   foreach part $help {
  46.     append text $part
  47.   }
  48.   
  49.   message $w.m -aspect 200 -text $text
  50.   frame $w.f -height 5p
  51.   label $w.l -text {(Click window to close.)}
  52.   
  53.   pack $w.m -padx 5p -pady 5p -fill both
  54.   pack $w.f -fill x
  55.   pack $w.l -fill x
  56.   
  57.   foreach widget [list $w.m $w.f $w.l] {
  58.     bind $widget <Any-ButtonRelease> "destroy $w"
  59.   }
  60.   
  61.   return $w
  62. }
  63.  
  64. proc jinstall:mkentry { w prompt var default help } {
  65.   global jinstall
  66.   if ![info exists jinstall($var)] {set jinstall($var) $default}
  67.   
  68.   frame $w
  69.   label $w.l \
  70.     -anchor e \
  71.     -width 30 \
  72.     -text $prompt
  73.   entry $w.e \
  74.     -width 40 \
  75.     -borderwidth 2p \
  76.     -relief sunken \
  77.     -textvariable jinstall($var)
  78.   button $w.b \
  79.     -text Help \
  80.     -command [list jinstall:show_help $help]
  81.   
  82.   pack $w.l -side left
  83.   pack $w.e -side left -fill x
  84.   pack $w.b -side right -padx 8p -pady 2p
  85.   
  86.   return $w
  87. }
  88.  
  89. proc jinstall:mkcheckbox { w prompt var default help } {
  90.   global jinstall
  91.   if ![info exists jinstall($var)] {set jinstall($var) $default}
  92.   
  93.   frame $w
  94.   label $w.l \
  95.     -anchor e \
  96.     -width 30 \
  97.     -text $prompt
  98.   checkbutton $w.cb \
  99.     -text Yes \
  100.     -relief flat \
  101.     -variable jinstall($var)
  102.   button $w.b \
  103.     -text Help \
  104.     -command [list jinstall:show_help $help]
  105.   
  106.   pack $w.l -side left
  107.   pack $w.cb -side left -fill x
  108.   pack $w.b -side right -padx 8p -pady 2p
  109.   
  110.   return $w
  111. }
  112.  
  113. proc jinstall:tab_ring { args } {
  114.   # index of last widget
  115.   set last [expr {[llength $args] - 1}]
  116.   
  117.   for {set i 0} {$i < $last} {incr i} {
  118.     set this [lindex $args $i]
  119.     set next [lindex $args [expr {$i + 1}]]
  120.     bind $this <Tab> "focus $next"
  121.     bind $next <Shift-Tab> "focus $this"
  122.   }
  123.   
  124.   # ... and bind last to focus on first:
  125.   set this [lindex $args $last]
  126.   set next [lindex $args 0]
  127.   bind $this <Tab> "focus $next"
  128.   bind $next <Shift-Tab> "focus $this"
  129. }
  130.  
  131. proc jinstall:log { string } {
  132.   if 0 {
  133.     puts stderr $string
  134.   }
  135. }
  136.  
  137. proc jinstall:read { filename } {
  138.   set file [open $filename r]
  139.   set string [read $file]
  140.   close $file
  141.   return $string
  142. }
  143.  
  144. proc jinstall:mkdir { directory } {
  145.   if ![file exists $directory] {
  146.     if [catch [list exec mkdir -p $directory]] {
  147.       jinstall:log "Unable to create directory $directory."
  148.       return 1
  149.     } else {
  150.       jinstall:log "Making directory $directory."
  151.       return 0
  152.     }
  153.   } else {
  154.     if ![file isdirectory $directory] {
  155.       jinstall:log \
  156.         "File $directory exists, but is not a directory - cannot proceed."
  157.       return 1
  158.     } else {
  159.       jinstall:log "Directory $directory already exists."
  160.       return 0
  161.     }
  162.   }
  163. }
  164.  
  165. proc jinstall:cp-r { file directory } {
  166.   jinstall:log "Installing $file in $directory."
  167.   if [catch [list exec cp -r $file $directory]] {
  168.     jinstall:log "Unable to install $file in $directory."
  169.     return 1
  170.   } else {
  171.     return 0
  172.   }
  173. }
  174.  
  175. proc jinstall:install_script { script destination {interpreter wish} } {
  176.   global jinstall
  177.   
  178.   jinstall:log "Installing script $script with preamble as $destination."
  179.   
  180.   if [catch {set scriptfile [open $script r]}] {
  181.     jinstall:log "Unable to open $script for reading."
  182.     return 1
  183.   }
  184.   
  185.   set scripttext [read $scriptfile]
  186.   
  187.   # change interpreter name in magic line:
  188.   regsub -- \
  189.     "^#!\[^ \t\n\]*" \
  190.     $scripttext \
  191.     "#!$jinstall($interpreter)" \
  192.     scripttext
  193.   
  194.   # replace preamble:
  195.   set preamble [format $jinstall(preamble) $jinstall(normallib)]
  196.   regsub -- \
  197.     "\n## begin boiler_header\n.*\n## end boiler_header\n" \
  198.     $scripttext \
  199.     $preamble \
  200.     scripttext
  201.   
  202.   if [catch {set outputfile [open $destination w]}] {
  203.     jinstall:log "Unable to open $destination for writing."
  204.     return 1
  205.   }
  206.   
  207.   if [catch {puts $outputfile $scripttext}] {
  208.     jinstall:log "Unable to write to $outputfile."
  209.     return 1
  210.   }
  211.   close $outputfile
  212.   
  213.   if [catch {exec chmod 755 $destination}] {
  214.     jinstall:log "Unable to set permissions on $destination."
  215.     return 1
  216.   }
  217.   
  218.   return 0
  219. }
  220.  
  221. ######################################################################
  222.  
  223. proc jinstall:cancel {} {
  224.   exit 0
  225. }
  226.  
  227. proc jinstall:install_jstools {} {
  228.   global jinstall
  229.   jinstall:mkdir $jinstall(normalbin)
  230.   jinstall:mkdir $jinstall(normallib)
  231.   
  232.   foreach file [glob lib/j*] {
  233.     jinstall:cp-r $file $jinstall(normallib)
  234.   }
  235.   jinstall:cp-r lib/samples $jinstall(normallib)
  236.   auto_mkindex $jinstall(normallib) *.tcl
  237.   
  238.   foreach script {jabbrevs jbrowser jdoc jedit jhelp jmore jprefs} {
  239.     jinstall:install_script bin/$script $jinstall(normalbin)/$script
  240.   }
  241.   
  242.   if $jinstall(installtoys) {
  243.     jinstall:mkdir $jinstall(toybin)
  244.     foreach script {jcalendar jhotlist jlaunchpad jmsgs jnewbrowser jpeople } {
  245.       jinstall:install_script w-in-p/$script $jinstall(toybin)/$script
  246.     }
  247.     jinstall:install_script w-in-p/jperson $jinstall(toybin)/jperson
  248.   }
  249.   
  250.   if {[tk_dialog .done \
  251.     "Done" "Installation is complete." info "Quit" \
  252.     "Quit" "Re¡install"] == 0} {
  253.     exit 0
  254.   }
  255. }
  256.  
  257. ######################################################################
  258.  
  259. jinstall:mkentry .wish \
  260.   {Path to wish:} \
  261.   wish \
  262.   "/usr/local/bin/wish" \
  263.   {
  264.     {This is the full pathname to your wish interpreter, }
  265.     {normally /usr/local/bin/wish.  If you have a choice, }
  266.     {you should specify a Tk 3.6 wish interpreter.}
  267.   }
  268.  
  269. jinstall:mkentry .normalbin \
  270.   {Directory for production scripts:} \
  271.   normalbin \
  272.   "/usr/local/bin" \
  273.   {
  274.     {This is the pathname to the directory where you want to }
  275.     {install the "production" (i.e., documented and reasonably }
  276.     {robust) scripts, including jabbrevs, jbrowser, jdoc, jedit, }
  277.     {jmore, and jprefs.  This is also where jhelp, which is }
  278.     {obsolete, will be installed.  This is typically /usr/local/bin , }
  279.     {or something like /usr/local/jstools-3.0/bin .}
  280.   }
  281.  
  282. jinstall:mkentry .normallib \
  283.   {Directory for jstools libraries:} \
  284.   normallib \
  285.   "/usr/local/lib/jstools" \
  286.   {
  287.     {This is the pathname to the directory where you want to }
  288.     {install the jstools libraries.  The Tcl library files will be }
  289.     {installed here, and various other supporting files will be }
  290.     {installed in subdirectories of this directory.  This is typically }
  291.     {/usr/local/lib/jstools , or something like }
  292.     {/usr/local/jstools-3.0/lib .}
  293.   }
  294.  
  295. jinstall:mkcheckbox .installtoys \
  296.   {Install works¡in¡progress:} \
  297.   installtoys \
  298.   1 \
  299.   {
  300.     {If this is selected, then the jstools "works in progress" }
  301.     {will be installed - applications that aren't yet quite ready }
  302.     {for production work, as well as "toy" or "demo" applications.}
  303.   }
  304.  
  305. jinstall:mkentry .toybin \
  306.   {Works-in-progress directory:} \
  307.   toybin \
  308.   "/usr/local/lib/jstools/w-in-p" \
  309.   {
  310.     {This is the pathname to the directory where you want to }
  311.     {install the works¡in¡progress - unsupported jstools scripts.  }
  312.     {At present that includes jcalendar, jhotlist, jlaunchpad, }
  313.     {jmsgs, jnewbrowser, jpeople, and jperson.  These can be installed in }
  314.     {the same directory as the `production' scripts, but if you do }
  315.     {that, please make sure your users know that they are not as }
  316.     {robust as the documented scripts.}
  317.     "\n\n"
  318.     {The term `Works¡in¡progress' isn't completely accurate, since }
  319.     {I'm not doing any more work on jcalendar or jmsgs.}
  320.     "\n\n"
  321.     {You can ignore this entry if you're not installing the }
  322.     {works¡in¡progress.}
  323.   }
  324.  
  325. jinstall:mkentry .tclsh \
  326.   {Path to tclsh:} \
  327.   tclsh \
  328.   "/usr/local/bin/tclsh" \
  329.   {
  330.     {This is the full pathname of your tclsh interpreter.  }
  331.     {It's only used by jperson, so you can ignore this entry }
  332.     {if you're not installing the works¡in¡progress.}
  333.   }
  334.  
  335. pack [frame .topframe -height 5 -relief flat] -fill x
  336. pack .wish -fill x
  337. pack .normalbin -fill x
  338. pack .normallib -fill x
  339. pack .installtoys -fill x
  340. pack .toybin -fill x
  341. pack .tclsh -fill x
  342. pack [frame .bottomframe -height 5 -relief flat] -fill x
  343. pack [frame .rule -relief sunken -height 2 -borderwidth 1] -fill x
  344.  
  345. jinstall:tab_ring .wish.e .normalbin.e .normallib.e .toybin.e .tclsh.e
  346.  
  347. ######################################################################
  348.  
  349. frame .b
  350. button .b.install -text Install -width 8 -command jinstall:install_jstools
  351. button .b.cancel -text Cancel -width 8 -command jinstall:cancel
  352.  
  353. frame .b.spacer -width 5p
  354. pack .b.spacer -side right
  355.  
  356. pack .b.install .b.cancel -side right -padx 5p -pady 10p
  357. pack .b -fill x
  358.  
  359.